home *** CD-ROM | disk | FTP | other *** search
/ PC World 2008 March / PCWorld_2008-03_cd.bin / v cisle / pcwpic / pcwPicConverter.exe / pcwPicConverter.hta
Text File  |  2008-01-14  |  14KB  |  349 lines
  1. <HTML>
  2.  <HEAD>
  3.   <TITLE>PC-WORLD: Automatickß ·prava obrßzk∙ vp programu Irfan View
  4.   </TITLE>
  5.   <HTA:APPLICATION
  6.    ID = "PicConverter"
  7.    APPLICATIONNAME = "PicConverter"
  8.    BORDER = "normal"
  9.    CAPTION = "yes"
  10.    SHOWINTASKBAR = "yes"
  11.    SINGLEINSTANCE = "yes"
  12.    SYSMENU = "yes"
  13.    WINDOWSTATE = "normal"
  14.    SCROLL = "no"
  15.    SCROLLFLAT = "no"
  16.    VERSION = "1.0"
  17.    INNERBORDER = "no"
  18.    SELECTION = "no"
  19.    MAXIMIZEBUTTON = "no"
  20.    MINIMIZEBUTTON = "yes"
  21.    NAVIGABLE = "No"
  22.    CONTEXTMENU = "no"
  23.    BORDERSTYLE = "normal"/>
  24.  
  25. <STYLE type="text/css">
  26. body            {font-family:Tahoma,Verdana,Arial,Geneva;
  27.     border:none;
  28.     scrollbar-arrow-color: #BBF0FF;
  29.     scrollbar-base-color: #000000;
  30.     scrollbar-dark-shadow-color: #00204A;
  31.     scrollbar-track-color: #00204A;
  32.     scrollbar-face-color: #2969B5;
  33.     scrollbar-shadow-color: #000000;
  34.     scrollbar-highlight-color: #00204A;
  35.     scrollbar-3d-light-color: #00204A;
  36.     font-style:normal;
  37.     font-size:12;
  38.     color:#FFFFFF;
  39.     background-color:#2969B5;
  40.     filter:progid:DXImageTransform.Microsoft.Gradient(
  41.     GradientType=1,
  42.     StartColorStr="#00204A",
  43.     EndColorStr="#00357B");
  44. }
  45. .Label    {
  46.     font-family:Tahoma,Verdana,Arial,Geneva;
  47.     font-style:normal;
  48.     font-size:14;
  49.     font-weight:bold;
  50.     color:#FFFFFF;
  51.     background-color:transparent;
  52.     Border:none
  53. }
  54.  
  55. .Textbox    {
  56.     font-family:Tahoma,Verdana,Arial,Geneva;
  57.     font-style:normal;
  58.     font-weight:bold;
  59.     font-size:15;
  60.     color:#FFFFFF;
  61.     background-color:#00204A;
  62.     filter:progid:DXImageTransform.Microsoft.Gradient(
  63.     GradientType=1,
  64.     StartColorStr="#00204A",
  65.     EndColorStr="#00357B");
  66.     border-right: #999999 2pt solid;
  67.     border-top: #999999 2pt solid;
  68.     border-left: #999999 2pt solid;
  69.     border-bottom: #999999 2pt solid;
  70. }
  71.     
  72. .Button    {
  73.     font-family:Tahoma,Verdana,Arial,Geneva;
  74.     font-size:16;
  75.     font-weight:bold;
  76.      background-color:#008000;
  77.     color:#FFFFFF;
  78.     border-right: #000000 2pt solid;
  79.     border-top: #000000 2pt solid;
  80.     border-left: #000000 2pt solid;
  81.     border-bottom: #000000 2pt solid;
  82.     filter:Alpha(opacity=100, finishopacity=40, style=3);
  83.     
  84. <!--
  85.  a:link { font-family:verdana; font-size:12; color:#FF8000; }
  86.  a:visited { font-family:verdana; font-size:12; color:#FFFFFF; }
  87.  a:hover { font-family:verdana; font-size:12; color:#FF8000; font-weight:bold; }
  88. -->
  89. .Link    {
  90.     font-family:verdana;
  91.     font-size:12;
  92.     color:#FF8000;
  93.  
  94. }
  95. </STYLE>
  96.  
  97.  </HEAD>
  98.  <SCRIPT LANGUAGE="VBScript">
  99.     on error resume next
  100.     Set myshell = CreateObject("Wscript.Shell")
  101.     Set Appshell = CreateObject("Shell.Application")
  102.     Set myfiles = CreateObject("Scripting.FileSystemObject")
  103.     Dim IrfanCommand
  104.     
  105. '==========================================================================
  106.  
  107.     Sub SubInitFenster
  108.         on error resume next
  109.         Window.resizeTo 570, 470        'Zm∞na nastavenφ v²Üky a Üφ°ky 
  110.         IrfanCommand = myshell.regread("HKEY_CLASSES_ROOT\IrfanView\shell\open\command\")
  111.         if IrfanCommand = "" then
  112.             msgbox "Nejprve prosφm nainstalujte Irfan View", vbOkOnly+vbExclamation, "Chyba"
  113.             call SubQuit()
  114.         end if
  115.         XInput.Value = myshell.Regread("HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\X")
  116.         YInput.Value = myshell.Regread("HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\Y")
  117.         BInput.Value = myshell.Regread("HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\B")
  118.         HInput.Value = myshell.Regread("HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\H")
  119.         RBInput.Value = myshell.Regread("HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\RB")
  120.         RHInput.Value = myshell.Regread("HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\RH")
  121.         NameInput.Value = myshell.Regread("HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\Struktur")
  122.         if NameInput.Value = "" then Struktur = "Bild###"
  123.         FormatIndex = myshell.Regread("HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\Format")
  124.         TheFormat.options(Cint(FormatIndex)).selected = True
  125.         QuellInput.Value = myshell.Regread("HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\Qordner")
  126.         ZielInput.Value = myshell.Regread("HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\ZOrdner")
  127.     End Sub
  128.  
  129. '==========================================================================    
  130.     
  131.     Sub SubSet
  132.     IrfanPath = Replace(IrfanCommand, chr(34), "", 1, -1, vbTextCompare)
  133.     IrfanPath = Replace(IrfanPath, " %1", "", 1, -1, vbTextCompare)
  134.     if DatStruk.Value = "" then
  135.         msgbox "Chybφ zadßnφ vzorce pro vytvß°enφ nßzv∙ soubor∙", vbOkOnly+vbExclamation, "Chyba"
  136.         exit sub
  137.     elseif instr(1, DatStruk.Value, "#", vbTextCompare) = 0 then
  138.         msgbox "Zadejte do vzorce pro vytvß°enφ nßzv∙ soubor∙ vφce znak∙ '#', aby se nastavilo postupnΘ Φφslovßnφ obrßzk∙. V opaΦnΘm p°φpad∞ se bude neustßle p°episovat prvnφ soubor.", vbOkOnly+vbExclamation, "Chyba"
  139.         exit sub
  140.     elseif QuellInput.Value = "" then
  141.         msgbox "Zadejte slo₧ku se soubory obrßzk∙", vbOkOnly+vbExclamation, "Chyba"
  142.         exit sub
  143.     elseif ZielInput.Value = "" then
  144.         msgbox "Zadejte slo₧ku, kam se majφ umφstit upravenΘ obrßzky", vbOkOnly+vbExclamation, "Chyba"
  145.         exit sub
  146.     end if
  147.     document.all.item("setit").Disabled=True
  148.     document.all.item("Ende").Disabled=True
  149.     StatusLabel.Value = "Probφhß zpracovßnφ..."
  150.     
  151.     if XInput.Value = "" then XInput.Value = "0"
  152.     if YInput.Value = "" then YInput.Value = "0"
  153.     if BInput.Value = "" then BInput.Value = "0"
  154.     if HInput.Value = "" then XInput.Value = "0"
  155.     if RBInput.Value = "" then RBInput.Value = "0"
  156.     if RHInput.Value = "" then RHInput.Value = "0"
  157.     
  158.     myshell.Regwrite "HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\X", XInput.Value, "REG_SZ"
  159.     myshell.Regwrite "HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\Y", YInput.Value, "REG_SZ"
  160.     myshell.Regwrite "HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\B", BInput.Value, "REG_SZ"
  161.     myshell.Regwrite "HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\H", HInput.Value, "REG_SZ"
  162.     myshell.Regwrite "HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\RB", RBInput.Value, "REG_SZ"
  163.     myshell.Regwrite "HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\RH", RHInput.Value, "REG_SZ"
  164.     myshell.Regwrite "HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\Struktur", NameInput.Value, "REG_SZ"
  165.     myshell.Regwrite "HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\Format", TheFormat.selectedindex, "REG_SZ"
  166.     myshell.Regwrite "HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\Qordner", QuellInput.Value, "REG_SZ"
  167.     myshell.Regwrite "HKEY_CURRENT_USER\Software\PC-WELT\pcwPicConverter\ZOrdner", ZielInput.Value, "REG_SZ"
  168.  
  169.     Set QuellFolder=Myfiles.Getfolder(QuellInput.Value)
  170.     Set Dats = QuellFolder.Files
  171.     if not Instr(1, NameInput.Value, "#", vbTextCompare) = 0 then
  172.         fillcnt = 1
  173.     end if
  174.     if not Instr(1, NameInput.Value, "##", vbTextCompare) = 0 then
  175.         fillcnt = 2
  176.     end if
  177.     if not Instr(1, NameInput.Value, "###", vbTextCompare) = 0 then
  178.         fillcnt = 3
  179.     end if
  180.     if not Instr(1, NameInput.Value, "####", vbTextCompare) = 0 then
  181.         fillcnt = 4
  182.     end if
  183.     if not Instr(1, NameInput.Value, "#####", vbTextCompare) = 0 then
  184.         fillcnt = 5
  185.     end if
  186.     if not Instr(1, NameInput.Value, "######", vbTextCompare) = 0 then
  187.         fillcnt = 6
  188.     end if
  189.     
  190.     CropValues = XInput.Value & "," & YInput.Value & "," & BInput.Value & "," & HInput.Value
  191.     ResValues = RBInput.Value & "," & RBInput.Value
  192.     
  193.     n = 1
  194.     For Each Dat in Dats
  195.     MyExt = Ucase(myfiles.GetExtensionName(Dat))
  196.     if MyExt = "JPG" or MyExt = "B3D" or MyExt = "BMP" or MyExt = "DIB" or MyExt = "CAM" or MyExt = "CPT" or MyExt = "CLP" or MyExt = "CRW" or _
  197.     MyExt = "CR2" or MyExt = "DJVU" or MyExt = "IW44" or MyExt = "FITS" or MyExt = "FPX " or MyExt = "GIF" or MyExt = "ICO" or MyExt = "IMG" or _
  198.     MyExt = "JP2" or MyExt = "JPC" or MyExt = "J2K" or MyExt = "JPEG" or MyExt = "KDC" or MyExt = "QTIF" or MyExt = "PICT" or MyExt = "MNG" or _
  199.     MyExt = "JNG" or MyExt = "MRW" or MyExt = "ORF" or MyExt = "RAF" or MyExt = "DCR" or MyExt = "SRF" or MyExt = "PEF" or MyExt = "X3F" or _
  200.     MyExt = "NLM" or MyExt = "NOL" or MyExt = "NGG" or MyExt = "OTB" or MyExt = "DNG" or MyExt = "EFF" or MyExt = "NEF" or MyExt = "PBM" or _
  201.     MyExt = "PCX" or MyExt = "PCD" or MyExt = "PGM " or MyExt = "PIC" or MyExt = "PNG" or MyExt = "PPM" or MyExt = "PSD" or MyExt = "PSP" or _
  202.     MyExt = "SGI" or MyExt = "RGB" or MyExt = "RGBA" or MyExt = "TIF" or MyExt = "TIFF" or MyExt = "XBM" or MyExt = "XPM" then
  203.     
  204.         if len(n) < fillcnt then
  205.             m = String(fillcnt-len(n), "0") & n
  206.         else
  207.             m = n
  208.         end if
  209.         
  210.         Bildname = Replace(NameInput.Value, String(Fillcnt, "#"), m, 1, -1, vbTextCompare)
  211.         if not CropValues = "0,0,0,0" and not ResValues = "0,0" then
  212.             ret = myshell.run(chr(34) & IrfanPath & chr(34) & " " & chr(34) & Dat & chr(34) & " /crop=(" & CropValues & ")  /resize=(" & ResValues & ")  /resample /aspectratio /convert=" & chr(34) & ZielInput.Value & "\" & Bildname & "." & TheFormat.options(TheFormat.selectedindex).text & chr(34), 1, True)
  213.         elseif CropValues = "0,0,0,0" and not ResValues = "0,0" then
  214.             ret = myshell.run(chr(34) & IrfanPath & chr(34) & " " & chr(34)  & Dat & chr(34) & " /resize=(" & ResValues & ") /resample /aspectratio /convert=" & chr(34) & ZielInput.Value& "\" & Bildname & "." & TheFormat.options(TheFormat.selectedindex).text  & chr(34), 1, True)
  215.         elseif ResValues = "0,0" and not CropValues = "0,0,0,0" then
  216.             ret = myshell.run(chr(34) & IrfanPath & chr(34) & " " & chr(34) & Dat & chr(34) & " /crop=(" & CropValues & ") /convert=" & chr(34) & ZielInput.Value & "\" & Bildname & "." & TheFormat.options(TheFormat.selectedindex).text  & chr(34), 1, True)
  217.         else
  218.             ret = myshell.run(chr(34) & IrfanPath & chr(34) & " " & chr(34) & Dat & chr(34) & " /convert=" & chr(34) & ZielInput.Value & "\" & Bildname & "." & TheFormat.options(TheFormat.selectedindex).text  & chr(34), 1, True)
  219.         end if
  220.         n = n+1
  221.     end if
  222.     next
  223.     document.all.item("setit").Disabled=False
  224.     document.all.item("Ende").Disabled=False
  225.     StatusLabel.Value = "Hotovo"
  226.     End Sub
  227.  
  228. '==========================================================================    
  229.     
  230.     Sub SubBrowse(Nummer)
  231.            Set AppFolder = AppShell.BrowseForFolder(0, "Vyberte slo₧ku:",  &H0001, 17)
  232.            On Error Resume Next
  233.            StrOrdner = AppFolder.ParentFolder.ParseName(AppFolder.Title).Path
  234.            If err.number > 0 then 
  235.             i=instr(AppFolder, ":")
  236.             StrOrdner = mid(AppFolder, i - 1, 1) & ":\"
  237.         End If
  238.         If StrOrdner = "" Then Exit Sub
  239.         If Not (myfiles.FolderExists(StrOrdner)) then
  240.             g = MsgBox("Zadanß slo₧ka neexistuje." & Chr(10) & "Vyberte n∞jakou jinou.",16, "Skript PC-WORLDu: pcwPicConverter")
  241.             Exit Sub
  242.         End If
  243.         if Nummer = 0 then
  244.           QuellInput.Value = StrOrdner
  245.         elseif Nummer = 1 then
  246.           ZielInput.Value = StrOrdner
  247.         end if
  248.     End Sub
  249.     
  250. '==========================================================================    
  251.     
  252.     Sub SubQuit
  253.         Set myshell        = Nothing
  254.         Window.Close
  255.     End Sub
  256.  
  257. '==========================================================================
  258.   Function high(objekt) 
  259.      objekt.style.background ="#00FF00"
  260.      objekt.filters.alpha.finishopacity = 100
  261.      objekt.filters.alpha.opacity = 100
  262.     End Function
  263.  
  264. '==========================================================================
  265.  
  266.   function low(objekt)
  267.      objekt.style.background ="#008000"
  268.      objekt.filters.alpha.opacity = 100
  269.      objekt.filters.alpha.finishopacity = 40
  270.     End Function
  271.  
  272. '==========================================================================
  273.     
  274. </SCRIPT>
  275.  
  276. <BODY SCROLL="yes" ONLOAD="SubInitFenster">
  277. <TABLE WIDTH=100% BORDER=0 CELLPADDING=4 CELLSPACING=2>
  278.     <TR>
  279.         <TD WIDTH=100% align="left">
  280.             <b>Sou°adnice pro o°φznutφ:</b>
  281.         </TD>
  282.     </TR>
  283.     <TR>
  284.         <TD WIDTH=100% align="left">
  285.             X= <Input ID=XInput Class="Textbox" Type=text Value="" Size=7% Name=Xcoord Title="Zadejte poΦßteΦnφ hodnotu na vodorovnΘ ose (X)">
  286.             Y= <Input ID=YInput Class="Textbox" Type=text Value="" Size=7% Name=Ycoord Title="Zadejte poΦßteΦnφ hodnotu na svislΘ ose (Y)">
  287.             è= <Input ID=BInput Class="Textbox" Type=text Value="" Size=7% Name=Bcoord Title="Zadejte Üφ°ku o°φznutΘho obrßzku">
  288.             V= <Input ID=HInput Class="Textbox" Type=text Value="" Size=8% Name=Hcoord Title="Zadejte v²Üku o°φznutΘho obrßzku">
  289.         </TD>
  290.     </TR>
  291.     <TR>
  292.         <TD WIDTH=100% align="left">
  293.             <b>V²slednß velikost obrßzku:</b>
  294.         </TD>
  295.     </TR>
  296.     <TR>
  297.         <TD>
  298.             èφ°ka= <Input ID=RBInput Class="Textbox" Type=text Value="" Size=19% Name=BSize Title="Zadejte Üφ°ku novΘho obrßzku">
  299.             V²Üka= <Input ID=RHInput Class="Textbox" Type=text Value="" Size=19% Name=HSize Title="Zadejte v²Üku novΘho obrßzku">
  300.         </TD>
  301.     </TR>
  302.     <TR>
  303.         <TD>
  304.             <b>Nov² nßzev a formßt obrßzku:</b>
  305.         </TD>
  306.     </TR>
  307.     <TR>
  308.         <TD>
  309.             Vzorec= <Input ID=NameInput Class="Textbox" Type=text Value="Obrßzek###" Size=30% Name=DatStruk Title="Zadejte vzorec pro nßzev novΘho obrßzku, znak '#' znamenß postupnΘ Φφslovßnφ (max. 6 znak∙ '#')">
  310.             Formßt= <Select Class="textbox" Size=1 Name=TheFormat Title="V²sledn² formßt nov²ch soubor∙ s obrßzky">
  311.                 <option>BMP</option>
  312.                 <option>GIF</option>
  313.                 <option>JPG</option>
  314.                 <option>PNG</option>
  315.                 <option>PSD</option>
  316.                 <option>PSP</option>
  317.                 <option>TIF</option>
  318.                 </Select>
  319.         </TD>
  320.     </TR>
  321.     <TR>
  322.         <TD>
  323.             <b>P∙vodnφ slo₧ka:</b>
  324.         </TD>
  325.     </TR>
  326.     <TR>
  327.         <TD>
  328.             <Input ID=QuellInput Class="Textbox" Type=text Value="" Size=55% Name=Quelle Title="Vyberte slo₧ku, kterß obsahuje obrßzky, s kter²mi chcete pracovat">
  329.             <Input Type="button" Class="Button" OnClick="SubBrowse('0')" name="browseit0" Value=">>" onMouseOver="high(browseit0)" onMouseOut="low(browseit0)" Title="Vyberte slo₧ku obsahujφcφ obrßzky"/>
  330.         </TD>
  331.     </TR>
  332.     <TR>
  333.         <TD>
  334.             <b>Slo₧ka pro umφst∞nφ upraven²ch soubor∙:</b>
  335.         </TD>
  336.     </TR>
  337.     <TR>
  338.         <TD>
  339.             <Input ID=ZielInput Class="Textbox" Type=text Value="" Size=55% Name=Quelle Title="Vyberte slo₧ku, do nφ₧ se majφ umφstit upravenΘ obrßzky">
  340.             <Input Type="button" Class="Button" OnClick="SubBrowse('1')" name="browseit1" Value=">>" onMouseOver="high(browseit1)" onMouseOut="low(browseit1)" Title="Vyberte slo₧ku pro upravenΘ obrßzky"/>
  341.         </TD>
  342.     </TR>
  343.     </Table>
  344.     <Input Type="button" Class=Button OnClick="SubSet" Name="setit" Value="Pou₧φt" onMouseOver="high(setit)" onMouseOut="low(setit)" Title="Spustφ ·pravu"/>    
  345.       <Input Type="button" Class=Button OnClick="SubQuit" Name="Ende" Value="Konec" onMouseOver="high(Ende)" onMouseOut="low(Ende)" Title="UkonΦenφ utility"/>
  346.     <Input ID=StatusLabel Class="Label" Type=text Value="" Size=30% READONLY>
  347.  </BODY>
  348. </HTML>
  349.